home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / mail / imapperl.6 / imapperl / imap / imap.pl < prev    next >
Perl Script  |  1995-09-03  |  6KB  |  413 lines
  1. package imap;
  2.  
  3.  
  4. # require "syslog.pl";
  5.  
  6.  
  7. $AF_INET = 2;
  8. $SOCK_STREAM = 1;
  9.  
  10. $tag = "A000";
  11.  
  12.  
  13. sub init
  14. {
  15.     ($messageCB, $mailboxCB,$existsCB, $recentCB, $expungeCB, $flagsCB,
  16.      $searchCB, $fetchCB) = @_;
  17.  
  18.     $SIG{'HUP'} = \&imap'sighup;
  19.     $SIG{'INT'} = \&imap'sigint;
  20.     $SIG{'ALRM'} = \&imap'sigalarm;
  21.  
  22.     return 1;
  23. }
  24.  
  25.  
  26. sub open
  27. {
  28. local($host, $port) = @_;
  29. local($fh);
  30.  
  31.     &msg'debug("imap\'open $host $port");
  32.  
  33.     # &openlog("imap", 'pid', 'mail');
  34.  
  35.     $sockaddr = 'S n a4 x8';
  36.  
  37.     # chop($hostname = `hostname`);
  38.  
  39.     ($name, $aliases, $proto) = getprotobyname('tcp');
  40.     ($name, $aliases, $port) = getservbyname($port, 'tcp')
  41.                                         unless $port =~ /^\d+$/;
  42.     # ($name, $aliases, $type, $len, $localaddr) = gethostbyname($hostname);
  43.     ($name, $aliases, $type, $len, $serveraddr) = gethostbyname($host);
  44.  
  45.     # $localsock = pack($sockaddr, $AF_INET, 0, $localaddr);
  46.     $serversock = pack($sockaddr, $AF_INET, $port, $serveraddr);
  47.  
  48.     # ($a, $b, $c, $d) = unpack('C4', $localaddr);
  49.     ($p, $q, $r, $s) = unpack('C4', $serveraddr);
  50.     &msg'debug("connecting from $a.$b.$c.$d to port $port at $p.$q.$r.$s");
  51.  
  52.     if (!socket(S, $AF_INET, $SOCK_STREAM, $proto))
  53.     {
  54.         &msg'error("can not open socket");
  55.         return 0;
  56.     }
  57.  
  58.     # if (!bind(S, $localsock))
  59.     # {
  60.     #     &msg'error("can not bind socket");
  61.     #     return 0;
  62.     # }
  63.  
  64.     if (!connect(S, $serversock))
  65.     {
  66.         &msg'error("can not connect");
  67.         return 0;
  68.     }
  69.  
  70.     $fh = select(S); $| = 1; select($fh);
  71.  
  72.     return 1;
  73. }
  74.  
  75. sub close
  76. {
  77.     &msg'debug("imap\'close");
  78.  
  79.     # &closelog();
  80.  
  81.     close(S);
  82. }
  83.  
  84.  
  85. sub noop
  86. {
  87.     &msg'debug("imap\'noop");
  88.  
  89.     return &send("NOOP");
  90. }
  91.  
  92.  
  93. sub login
  94. {
  95. local($user) = @_;
  96.  
  97.     &msg'debug("imap\'login $user");
  98.  
  99.     system "stty -echo </dev/tty >/dev/tty";
  100.     print STDERR "password: ";
  101.     chop($passwd = <STDIN>);
  102.     print STDERR "\n";
  103.     system "stty echo </dev/tty >/dev/tty";
  104.  
  105.     return &send("LOGIN $user $passwd");
  106. }
  107.  
  108. sub logout
  109. {
  110.     &msg'debug("imap\'logout");
  111.  
  112.     return &send("LOGOUT");
  113. }
  114.  
  115.  
  116. sub select
  117. {
  118.     local($mailbox) = @_;
  119.  
  120.     &msg'debug("imap\'select $mailbox");
  121.  
  122.     return &send("SELECT $mailbox");
  123. }
  124.  
  125.  
  126. sub find
  127. {
  128. local($pattern) = @_;
  129.  
  130.     &msg'debug("imap\'find $pattern");
  131.  
  132.     return &send("FIND MAILBOXES $pattern");
  133. }
  134.  
  135.  
  136. sub create
  137. {
  138. local($mailbox) = @_;
  139.  
  140.     &msg'debug("imap\'create $mailbox");
  141.  
  142.     return &send("CREATE $mailbox");
  143. }
  144.  
  145.  
  146. sub delete
  147. {
  148. local($mailbox) = @_;
  149.  
  150.     &msg'debug("imap\'delete $mailbox");
  151.  
  152.     return &send("DELETE $mailbox");
  153. }
  154.  
  155.  
  156. sub subscribe
  157. {
  158. local($mailbox) = @_;
  159.  
  160.     &msg'debug("imap\'subscribe $mailbox");
  161.  
  162.     return &send("SUBSCRIBE MAILBOX $mailbox");
  163. }
  164.  
  165.  
  166. sub unsubscribe
  167. {
  168. local($mailbox) = @_;
  169.  
  170.     &msg'debug("imap\'unsubscribe $mailbox");
  171.  
  172.     return &send("UNSUBSCRIBE MAILBOX $mailbox");
  173. }
  174.  
  175.  
  176. sub check
  177. {
  178.     &msg'debug("imap\'check");
  179.  
  180.     return &send("CHECK");
  181. }
  182.  
  183.  
  184. sub expunge
  185. {
  186.     &msg'debug("imap\'expunge");
  187.  
  188.     return &send("EXPUNGE");
  189. }
  190.  
  191.  
  192. sub fetch
  193. {
  194. local($sequence, $data) = @_;
  195.  
  196.     &msg'debug("imap\'fetch $sequence $data");
  197.  
  198.     return &send("FETCH $sequence $data");
  199. }
  200.  
  201.  
  202. sub search
  203. {
  204. local($criteria) = @_;
  205.  
  206.     &msg'debug("imap\'search $criteria");
  207.  
  208.     return &send("SEARCH $criteria");
  209. }
  210.  
  211.  
  212. sub store
  213. {
  214. local($sequence, $data, $value) = @_;
  215.  
  216.     &msg'debug("imap\'store $sequence $data $value");
  217.  
  218.     return &send("STORE $sequence $data $value");
  219. }
  220.  
  221.  
  222. sub puts
  223. {
  224. local($line) = @_;
  225.  
  226.     print S "$line\n";
  227. }
  228.  
  229.  
  230. sub send
  231. {
  232. local($line) = @_;
  233.  
  234.     &msg'debug("imap\'send $line");
  235.  
  236.     &puts("$tag $line");
  237.  
  238.     return $tag++;
  239. }
  240.  
  241.  
  242. sub gets
  243. {
  244. local($count, $timeout) = @_;
  245. local($n, $line);
  246.  
  247.     alarm($timeout);
  248.  
  249.     if ($count == 0)
  250.     {
  251.         $/ = "\015\012";
  252.         $line = <S>;
  253.         $n = length($line);
  254.         $/ = "\n";
  255.     }
  256.     else
  257.     {
  258.         $n = read(S, $line, $count);
  259.     }
  260.  
  261.     alarm(0);
  262.  
  263.     return ($n, $line);
  264. }
  265.  
  266.  
  267. sub recv
  268. {
  269. local($timeout) = @_;
  270. local($line, $i, $n, $len, @data);
  271.  
  272.     ($n, $data[0]) = &gets(0, $timeout);
  273.     $line = $data[0];
  274.  
  275.     for ($i = 0; $line =~ /\{([0-9]+)\}\015\012$/m; )
  276.     {
  277.         for ($len = $1, $i++; $len > 0; $i++)
  278.         {
  279.             ($n, $data[$i]) = &gets($len, $timeout);
  280.             $len = $len - $n;
  281.             $line = $data[$i];
  282.         }
  283.         if ($len == 0)
  284.         {
  285.             ($n, $data[$i]) = &gets(0, $timeout);
  286.             $line = $data[$i];
  287.         }
  288.     }
  289.  
  290.     return join("", @data);
  291. }
  292.  
  293.  
  294. sub loop
  295. {
  296. local($match, $timeout) = @_;
  297. local($tag, $result, $message);
  298.  
  299.     &msg'debug("imap\'loop $match");
  300.  
  301.     while (1)
  302.     {
  303.         ($tag, $result, $message) = &imap'handle(&recv($timeout));
  304.  
  305.         if ($tag eq $match)
  306.         {
  307.             return ($tag, $result, $message);
  308.         }
  309.     }
  310.  
  311.     return "";
  312. }
  313.  
  314. sub handle
  315. {
  316. local($data) = @_;
  317. local($tag, $result, $command, $message, $remainder);
  318.  
  319.     ($tag, $result, $data) = split(' ', $data, 3);
  320.     ($command, $remainder) = split(' ', $data, 2);
  321.     ($message, $remainder) = split(/\015\012/, $data, 2);
  322.  
  323.     &msg'debug("imap\'handle $tag $result $message");
  324.  
  325.     RESULT:
  326.     {
  327.     $result =~ /[0-9]+/ && do
  328.         {
  329.             COMMAND:
  330.             {
  331.             $command =~ /EXISTS/i && do
  332.                 {
  333.                     eval { &$existsCB($tag, $result); };
  334.                     &msg'debug($@) if $@;
  335.                     last COMMAND;
  336.                 };
  337.             $command =~ /RECENT/i && do
  338.                 {
  339.                     eval { &$recentCB($tag, $result); };
  340.                     &msg'debug($@) if $@;
  341.                     last COMMAND;
  342.                 };
  343.             $command =~ /EXPUNGE/i && do
  344.                 {
  345.                     eval { &$expungeCB($tag, $result); };
  346.                     &msg'debug($@) if $@;
  347.                     last COMMAND;
  348.                 };
  349.             $command =~ /FETCH/i && do
  350.                 {
  351.                     eval { &$fetchCB($tag, $result, $data); };
  352.                     &msg'debug($@) if $@;
  353.                     last COMMAND;
  354.                 };
  355.             }
  356.             last RESULT;
  357.         };
  358.     $result =~ /FLAGS/i && do
  359.         {
  360.             eval { &$flagsCB($tag, $data); };
  361.             &msg'debug($@) if $@;
  362.             last RESULT;
  363.         };
  364.     $result =~ /SEARCH/i && do
  365.         {
  366.             eval { &$searchCB($tag, $data); };
  367.             &msg'debug($@) if $@;
  368.             last RESULT;
  369.         };
  370.     $result =~ /MAILBOX/i && do
  371.         {
  372.             eval { &$mailboxCB($tag, $data); };
  373.             &msg'debug($@) if $@;
  374.             last RESULT;
  375.         };
  376.     ($result =~ /BYE/i ||
  377.     $result =~ /OK/i ||
  378.     $result =~ /NO/i ||
  379.     $result =~ /BAD/i) && do
  380.         {
  381.             eval { &$messageCB($tag, $result, $message); };
  382.             &msg'debug($@) if $@;
  383.             last RESULT;
  384.         };
  385.     }
  386.  
  387.     return ($tag, $result, $message);
  388. }
  389.  
  390.  
  391. sub sighup
  392. {
  393.     &msg'error("exit by hangup");
  394.     exit 2;
  395. }
  396.  
  397.  
  398. sub sigint
  399. {
  400.     &msg'error("exit by interrupt");
  401.     &close();
  402.     exit 1;
  403. }
  404.  
  405.  
  406. sub sigalarm
  407. {
  408.     &msg'error("exit by alarm");
  409.     exit 3;
  410. }
  411.  
  412. 1;
  413.